home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / MEDICAL / 2608A.ZIP / GP.ZIP / PATIENT.SRC < prev    next >
Text File  |  1990-11-03  |  22KB  |  1,104 lines
  1. ;\|
  2. ;PATIENT.SRC     Translated from PATIENT.EDT by Roger Mathew's EDT2SRC Ver 4.11
  3. ;PATIENT  12:32:31 PM  17/ 6/90   |
  4. FIELDS:
  5. define(AOD|A|1||10)
  6. define(MN|A|30||10)
  7. define(DO|A|8||10)
  8. define(QU|A|10||10)
  9. define(DS|A|30||10)
  10. define(QTY|N|3||10)
  11. define(ISN|N|3||10)
  12. define(CTR|N|2||)
  13. define(MEM_RPD|S|8||10)
  14. define(CTR2|N|2||)
  15. define(S1|A|1||)
  16. define(RP_POS|A|4||)
  17. define(DATNUM|N|7||)
  18. define(MEM_RPND|S|8||)
  19. define(CTRDAT|N|2||)
  20. define(NEXT|A|1||)
  21. define(OFF|A|4||)
  22. define(LIST_SIZE|N|8||)
  23. define(B8|A|8||)
  24. define(N5.2|N|5|2|)
  25. define(N5|N|5||)
  26. define(A5|A|5||)
  27. define(AGE|N|5|2|)
  28. define(TD|S|8||)
  29. define(REC.NUM|N|8|0|)
  30. define(DATERP|S|8||)
  31. define(PUNC1|N|2|0|)
  32. define(TM|A|27||12)
  33. define(P.2.0.2|N|2|0|)
  34. define(CHOICE|N|2|0|)
  35. define(YES.NO|A|1||)
  36. define(AB|A|5||)
  37. define(CODCTR|N|1||)
  38. define(A1|A|2||)
  39. define(DATCTR|A|2||)
  40. define(PATCTR|N|4|0|)
  41. define(A30|A|30||)
  42. define(B30|A|30||)
  43. define(B8|A|8||)
  44. define(A8|A|8||)
  45. define(YN|A|1||)
  46. define(DAY|A|2||)
  47. define(TD1|A|8||)
  48. define(RECPOS|A|4||)
  49. define(LAST_ERROR|N|2||)
  50. define(XCNTR|N|3||)
  51. define(POR|A|5||)
  52. define(DUMMY|A|5||)
  53. define(DUMMY2|A|30||)
  54. define(FLAG|A|1||)
  55. define(YCNTR|N|3||)
  56. define(XCNTR6|N|3||)
  57. define(XCNTR1|N|3||)
  58. define(XCNTR2|N|3||)
  59. define(XCNTR3|N|3||)
  60. define(XCNTR4|N|3||)
  61. define(MENU.HLDR|A|47||13)
  62. define(XCNTR5|N|3||)
  63. date(TD|G)
  64. trap(6|S|TRACE)
  65. trap(5|S|SIX)
  66. open(PATIENT||1|EXIT2)
  67. open(RP||1|EXIT2)
  68. open(RECALLS||0|EXIT2)
  69. open(IMDATE||0|EXIT2)
  70. open(PAEDS||0|EXIT2)
  71. open(DIABETIC||0|EXIT2)
  72. open(ABBREV||0|EXIT2)
  73. open(RPABBREV||0|EXIT2)
  74. open(GPSETUP||0|EXIT2)
  75. open(PROCEDE||0|EXIT2)
  76. open(MEMORY||0|)
  77. trap(L|I)
  78. find(E|RECORD.NUMBER|EXIT|N)
  79. find(B|HEADING|EXIT2|)
  80. REC.NUM = (RECORD.NUMBER)
  81. clr(PATIENT|B)
  82. ;BEGINNING OF AGE SEX REGISTER|
  83. PATIENT:
  84. mount(PATIENT|S)
  85. PAT.NAME:
  86. LIST_SIZE =nrc(PATIENT)
  87. gosub PAT.TRAP
  88. AGE = (0)
  89. clrlne(1|25)
  90. enter(PATIENT.NAME|" ABCDEFGHIJKLMNOPQRSTUVWXYZ,'-"||CLEARPAT|Y|Y|N|||N)
  91. PUNC1 =loc(","|PATIENT.NAME|1||14)
  92. P.2.0.2 = (PUNC1+1)
  93. if PUNC1 = (0) reent
  94. S1 =mid(PATIENT.NAME|P.2.0.2|1|)
  95. if S1 <> ("") reent
  96. PUNC1 = (0)
  97. P.2.0.2 = (0)
  98. S1 = ("")
  99. ifdup(PATIENT.NAME|S|DUP.NAME)
  100. gosub CHECK
  101. RESS:
  102. enter(ADDRESS1||||Y|Y|N|||N)
  103. lnum(PATCTR)
  104. S1 =mid(ADDRESS1|1|1|)
  105. if S1 = ("@") do
  106. {
  107. AB = (ADDRESS1)
  108. gosub LETABV
  109. AB = ("")
  110. ADDRESS1 = (ABBREV.NAME)
  111. gosub CLRABV
  112. goto RESS
  113. }
  114. AREA:
  115. enter(AREA||||Y|Y|N|||N)
  116. lnum(PATCTR)
  117. S1 =mid(AREA|1|1|)
  118. if S1 = ("@") do
  119. {
  120. AB = (AREA)
  121. gosub LETABV
  122. AB = ("")
  123. AREA = (ABBREV.NAME)
  124. gosub CLRABV
  125. }
  126. enter(POSTCODE||||Y|Y|N|||N)
  127. enter(DATE.OF.BIRTH||||N|Y|N|||N)
  128. if DATE.OF.BIRTH > (TD) reent
  129. if DATE.OF.BIRTH < (TD-36500) reent
  130. N5.2 = (TD-DATE.OF.BIRTH/365)
  131. AGE = (N5.2)
  132. SEX:
  133. enter(MARITAL.STATUS|"MS"|||Y|Y|N|||N)
  134. enter(SEX|"MF"|||Y|Y|N|||N)
  135. enter(DISPENSING|"YNX"|||Y|Y|N|||N)
  136. enter(DOCTOR|"1234"|||N|Y|N|||N)
  137. enter(NHS.NUM||||Y|Y|N|||N)
  138. enter(PAT.REG||||N|Y|N|||N)
  139. enter(pat_flag|" Y"|||y|y|n|||n)
  140. enter(NOTES.REC||||N|Y|N|||N)
  141. enter(TELEPHONE||||N|N|N|||N)
  142. enter(SEEN||||N|Y|N|||N)
  143. if DATE_SEEN > (SEEN) do
  144. {
  145. SEEN = (DATE_SEEN)
  146. }
  147. else
  148. {
  149. DATE_SEEN = (SEEN)
  150. }
  151. enter(SMOKER|" Y"|VIS_HELP||Y|Y|N|||N)
  152. enter(VISIT|" YSV"|75_HELP||Y|Y|N|||N)
  153. SAVE.PAT:
  154. gosub TRAPS
  155. trap(O|G|FILE_ERROR)
  156. LAST.UPDATE = (TD)
  157. if RECORD.NUMBER > (0) goto SAVE.PATX
  158. RECORD.NUMBER = (REC.NUM+1)
  159. SAVE.PPPX:
  160. save(PATIENT|Y|Y|PAT.NAME)
  161. SAVE.QQQX:
  162. REC.NUM = (REC.NUM+1)
  163. trap(O|D)
  164. goto PAT.NAME
  165. SAVE.PATX:
  166. save(PATIENT|Y|Y|PAT.NAME)
  167. goto PAT.NAME
  168. DELETE:
  169. trap(L|G|DEL.LOCK)
  170. pmsg(@R;"Delete all records relating to this patient -Y/N ?"|1|25|N|N|S|YES.NO)
  171. clrlne(1|25)
  172. if YES.NO <> ("Y") goto PAT.NAME
  173. DLT.RP:
  174. RP.REF = (RECORD.NUMBER)
  175. find(M|RP.REF|DEL.CODE|)
  176. del(RP|N)
  177. goto DLT.RP
  178. DEL.CODE:
  179. COD.REF = (RECORD.NUMBER)
  180. find(M|COD.REF|DEL_IM|)
  181. del(RECALLS|N)
  182. DEL_IM:
  183. IMDATE.COD = (RECORD.NUMBER)
  184. find(M|IMDATE.COD|DEL_P|)
  185. del(IMDATE|N)
  186. DEL_P:
  187. P_COD = (RECORD.NUMBER)
  188. find(M|P_COD|DEL_DIAB|)
  189. del(PAEDS|N)
  190. DEL_DIAB:
  191. DIAB_REF = (RECORD.NUMBER)
  192. find(M|DIAB_REF|DEL_PROC|)
  193. del(DIABETIC|N)
  194. DEL_PROC:
  195. PROC_REF = (RECORD.NUMBER)
  196. find(M|PROC_REF|DLT.PAT|)
  197. del(PROCEDE|N)
  198. DLT.PAT:
  199. del(PATIENT|N)
  200. trap(L|G|PAT.LOCK)
  201. goto PAT.NAME
  202. DUP.NAME:
  203. if RECORD.NUMBER > (0) goto RETDUP
  204. bell
  205. pmsg(@R;"This name is already on file!"|1|25|Y|N|S|)
  206. clrlne(1|25)
  207. clr(PATIENT|B)
  208. RETDUP:
  209. ret
  210. ;HERE ARE THE RP ENTRY PROCEDURES.|
  211. RP:
  212. mount(RP|S)
  213. RP.NAME:
  214. RP.PATX:
  215. clr(RP|B)
  216. gosub PAT.TRAP
  217. trap(T|I)
  218. trap(J|G|PATIENT)
  219. trap(S|I)
  220. trap(L|G|PAT.LOCKRP)
  221. trap(D|I)
  222. trap(C|G|CLRPS)
  223. clrlne(1|25)
  224. enter(PATIENT.NAME|||CLRPS|Y|N|N|||N)
  225. RP.RETURN:
  226. find(G|PATIENT.NAME|RP.NAME)
  227. gosub CHECK
  228. RECPOS =rcn(PATIENT|G)
  229. if DISPENSING = ("X") do
  230. {
  231. gosub TRAPS
  232. trap(Q|I)
  233. saves(1)
  234. rev
  235. window(19|13|2|32)
  236. UPTRAP:
  237. pmsg("DISPENSING = X CHANGE IT NOW!"|1|1|N|N|S|)
  238. enter(DISPENSING|"YNX"||UPTRAP|Y|Y|N|30|1|N)
  239. save(PATIENT|N|N)
  240. find(M|RECORD.NUMBER|RP|)
  241. frg
  242. redsp(1)
  243. trap(Q|G|EXIT)
  244. if DISPENSING = ("X") goto RP.NAME
  245. gosub PAT.TRAP
  246. }
  247. RP.REF = (RECORD.NUMBER)
  248. MEM_RPND = (0)
  249. find(M|RP.REF|AD_RP|)
  250. AD_RP:
  251. gosub RP.TRAP
  252. enter(AUTO.ON.DEMAND|"AD"||RP.PATX|Y|Y|N|||N)
  253. YN = (AUTO.ON.DEMAND)
  254. if CONTROL = ("N") goto AD2
  255. enter(ISS.RESTRICT|"YN"|||Y|Y|N|||N)
  256. if ISS.RESTRICT = ("N") goto AD2
  257. enter(HOW.MANY.ISSUES||||N|N|N|||N)
  258. RESTRICT.NO = (HOW.MANY.ISSUES-ISSUE.NO)
  259. AD2:
  260. if MEDICATION > (" ") goto RESTRICT
  261. RP.FIRST = (MEM_RPND)
  262. enter(RP.FIRST||||N|Y|N|||N)
  263. DATERP = (RP.FIRST)
  264. if RP.FIRST < (TD-28) reent
  265. if RP.FIRST > (TD+56) reent
  266. REVIEW.RP = (RP.FIRST+187)
  267. RP.DAYS.SUPPLY = (28)
  268. RP.NEXT.DUE = (RP.FIRST+RP.DAYS.SUPPLY)
  269. if MEDICATION = (" ") goto RESTRICT
  270. enter(ISSUE.1||||N|Y|N|||N)
  271. enter(RP.NEXT.DUE||||N|Y|N|||N)
  272. RESTRICT:
  273. trap(R|S|REL_RP)
  274. enter(MEDICATION||||Y|Y|N|||N)
  275. lnum(PATCTR)
  276. YN = (AUTO.ON.DEMAND)
  277. DATERP = (RP.FIRST)
  278. AB = (MEDICATION)
  279. S1 =mid(MEDICATION|1|1|)
  280. FLAG = ("A")
  281. if S1 <> ("@") goto PATMENU
  282. if S1 = ("@") do
  283. {
  284. trap(U|I)
  285. trap(W|I)
  286. trap(J|I)
  287. trap(1|I)
  288. FLAG = ("A")
  289. AB = (MEDICATION)
  290. gosub LETRPABV
  291. AB = ("")
  292. MEDICATION = (RPABBREV.NAME)
  293. RPWARNING = (WARNING)
  294. trap(U|D)
  295. gosub CLRABV
  296. }
  297. LIST_DRUG:
  298. enter(DOSE||||Y|Y|N|||N)
  299. enter(QUANTITY||||N|Y|N|||N)
  300. enter(DIRECTIONS||||Y|Y|N|||N)
  301. S1 =mid(DIRECTIONS|1|1|)
  302. lnum(PATCTR)
  303. FLAG = ("B")
  304. AB = (DIRECTIONS)
  305. if S1 <> ("@") goto PATMENU
  306. if S1 = ("@") do
  307. {
  308. trap(U|I)
  309. trap(W|I)
  310. trap(J|I)
  311. trap(1|I)
  312. FLAG = ("B")
  313. AB = (DIRECTIONS)
  314. gosub LETRPABV
  315. AB = ("")
  316. DIRECTIONS = (RPABBREV.NAME)
  317. gosub CLRABV
  318. }
  319. DIR_FIND:
  320. QTY:
  321. enter(RP.DISP.QTY||||N|Y|N|||N)
  322. enter(RP.WHAT.DISP||||Y|Y|N|||N)
  323. SAVE.RP:
  324. gosub TRAPS
  325. RECPOS =rcn(PATIENT|S)
  326. RP.REF = (RECORD.NUMBER)
  327. if RP.REF = (0) goto RP.NAME
  328. AUTO.ON.DEMAND = (YN)
  329. RP.FIRST = (DATERP)
  330. save(RP|Y|Y|RP.NAME)
  331. goto AD_RP
  332. RP.RELATES:
  333. if RP.REF = (0) goto RTN
  334. if NEXT = ("N") do
  335. {
  336. NEXT = ("")
  337. find(N|RP|RTN|)
  338. }
  339. else
  340. {
  341. if NEXT = ("P") do
  342. {
  343. NEXT = ("")
  344. find(P|RP|RTN|)
  345. }
  346. }
  347. OFF =rcn(RP|G)
  348. RECORD.NUMBER = (RP.REF)
  349. find(M|RECORD.NUMBER|RTN|N)
  350. RECPOS =rcn(PATIENT|G)
  351. OFF =rcn(RP|S)
  352. RTN:
  353. ret
  354. DELETE.RP:
  355. YES.NO = ("Y")
  356. pmsg("DELETE Y/N:"|1|24|Y|N|S|YES.NO)
  357. clrlne(1|24)
  358. if YES.NO <> ("Y") goto AD_RP
  359. del(RP|N)
  360. goto AD_RP
  361. AD_RPX:
  362. goto AD_RP
  363. AGE.REL:
  364. N5.2 = (TD-DATE.OF.BIRTH/365)
  365. AGE = (N5.2)
  366. ret
  367. CLEARPAT:
  368. clr(PATIENT|B)
  369. AGE = (" ")
  370. goto PAT.NAME
  371. CLEARRP:
  372. if AUTO.ON.DEMAND = ("A") then MEM_RPND = (RP.NEXT.DUE-28)
  373. clr(RP|B)
  374. goto AD_RP
  375. CLRPS:
  376. clr(PATIENT|B)
  377. clr(RP|B)
  378. AGE = ("")
  379. goto RP.NAME
  380. ;HERE ARE THE RP PRINTING ROUTINES|
  381. CODE:
  382. trap(1|I)
  383. COD.NAME:
  384. COD.PATX:
  385. gosub PAT.TRAP
  386. trap(1|I)
  387. trap(S|I)
  388. trap(C|G|CLCODS)
  389. trap(L|G|PAT.LOCKCO)
  390. trap(D|I)
  391. clrlne(1|25)
  392. clr(RECALLS|B)
  393. enter(PATIENT.NAME|||CLCODS|Y|N|N|||N)
  394. COD.RETURN:
  395. find(G|PATIENT.NAME|COD.NAME)
  396. gosub CHECK
  397. COD.REF = (RECORD.NUMBER)
  398. find(M|COD.REF|CCDA|)
  399. CCDA:
  400. gosub COD.TRAP
  401. trap(S|I)
  402. CODCTR = (0)
  403. CD2:
  404. for(CODCTR|1|9|1)
  405. {
  406. enter(COD[CODCTR]|||COD.NAME|Y|Y|N|||N)
  407. if COD.D[CODCTR] < (2415490) then COD.D[CODCTR] = (1721439+CODCTR)
  408. CTRDAT = (14+CODCTR)
  409. DATCTR = (CTRDAT)
  410. enter(COD.D[CODCTR]|||COD.NAME|N|Y|N|||N)
  411. A1 =mid(COD.D[CODCTR]|1|2|)
  412. DATNUM = (COD.D[CODCTR])
  413. if DATNUM <= (2415440) do
  414. {
  415. COD[CODCTR] = ("")
  416. COD.D[CODCTR] = (0)
  417. if CODCTR = (9) goto SAVE.COD
  418. }
  419. else
  420. {
  421. if A1 <> (DATCTR) reent
  422. }
  423. }
  424. trap(S|G|SAVE.COD)
  425. SAVE.COD:
  426. COD.REF = (RECORD.NUMBER)
  427. COD.PAT.NAME = (PATIENT.NAME)
  428. save(RECALLS|Y|N|CCDA)
  429. find(M|COD.REF||)
  430. goto CCDA
  431. DELETE.COD:
  432. del(RECALLS|Y|)
  433. goto COD.RETURN
  434. CLEARCOD:
  435. clr(RECALLS|B)
  436. goto CCDA
  437. CLCODS:
  438. clr(PATIENT|B)
  439. clr(RECALLS|B)
  440. AGE = ("")
  441. goto COD.NAME
  442. COD.TRAP:
  443. trap(7|I)
  444. trap(9|I)
  445. trap(J|G|PATIENT)
  446. trap(S|G|SAVE.COD)
  447. trap(C|G|CLEARCOD)
  448. trap(D|I)
  449. trap(N|I)
  450. trap(M|I)
  451. trap(F|I)
  452. trap(B|I)
  453. trap(G|I)
  454. trap(R|I)
  455. trap(U|D)
  456. trap(L|G|COD.LOCK)
  457. ret
  458. REL.COD:
  459. RECORD.NUMBER = (COD.REF)
  460. find(M|RECORD.NUMBER|CODRETT|)
  461. CODRETT:
  462. ret
  463. TRAPS:
  464. trap(Q|G|EXIT)
  465. trap(3|I)
  466. trap(S|I)
  467. trap(D|I)
  468. trap(T|I)
  469. trap(L|D)
  470. trap(R|I)
  471. trap(F|I)
  472. trap(N|I)
  473. trap(M|I)
  474. trap(B|I)
  475. trap(G|I)
  476. trap(C|I)
  477. trap(J|I)
  478. trap(U|D)
  479. trap(W|D)
  480. trap(1|I)
  481. ret
  482. CLEARALL:
  483. clr(PATIENT|B)
  484. clr(RP|B)
  485. ret
  486. FIELDCLR:
  487. S1 = ("")
  488. AGE = (0)
  489. AB = ("")
  490. PATCTR = (0)
  491. A30 = ("")
  492. B30 = ("")
  493. A8 = ("")
  494. B8 = ("")
  495. N5 = (0)
  496. ret
  497. PAT.TRAP:
  498. trap(1|I)
  499. trap(O|D)
  500. trap(T|G|SEEALL)
  501. trap(J|G|RP)
  502. trap(S|I)
  503. trap(R|S|AGE.REL)
  504. trap(F|D)
  505. trap(N|D)
  506. trap(M|D)
  507. trap(B|D)
  508. trap(G|D)
  509. trap(C|G|CLEARPAT)
  510. trap(D|G|DELETE)
  511. trap(Q|G|EXIT)
  512. trap(3|I)
  513. trap(U|D)
  514. trap(L|G|PAT.LOCK)
  515. ret
  516. RP.TRAP:
  517. trap(J|G|PATIENT)
  518. trap(T|I)
  519. trap(L|G|RP.LOCK)
  520. trap(S|G|SAVE.RP)
  521. trap(C|G|CLEARRP)
  522. trap(D|G|DELETE.RP)
  523. trap(N|S|NEXT)
  524. trap(M|S|PREV)
  525. trap(F|D)
  526. trap(B|D)
  527. trap(G|D)
  528. trap(R|I)
  529. trap(U|D)
  530. trap(3|I)
  531. ret
  532. NEXT:
  533. NEXT = ("N")
  534. gosub RP.RELATES
  535. ret
  536. PREV:
  537. NEXT = ("P")
  538. gosub RP.RELATES
  539. ret
  540. RP.EXIT:
  541. gosub TRAPS
  542. goto EXIT
  543. LETABV:
  544. ABBREVIATION = (AB)
  545. find(M|ABBREVIATION|GET.ABBREV)
  546. goto RET
  547. GET.ABBREV:
  548. gosub LETTRAP
  549. saves(1)
  550. trap(Q|I)
  551. window(10|14|5|60)
  552. pmsg("ABBREVIATION :";ABBREVIATION|1|2|N|N|S|)
  553. pmsg("ENTER ABBREV.NAME:"|1|4|N|N|S|ABBREV.NAME)
  554. if ABBREV.NAME = ("") goto NOABV
  555. save(ABBREV|N|N|GET.ABBREV)
  556. find(M|ABBREVIATION||)
  557. NOABV:
  558. redsp(1)
  559. trap(Q|G|EXIT)
  560. gosub FINDLINE
  561. RET:
  562. ret
  563. LETRPABV:
  564. RPABBREVIATION = (AB)
  565. find(M|RPABBREVIATION|GET.RPABBR)
  566. gosub FIND_DRCD
  567. goto RETT
  568. GET.RPABBR:
  569. gosub LETTRAP
  570. YES.NO = ("")
  571. if FLAG <> ("X") do
  572. {
  573. RPABBREVIATION = (AB)
  574. saves(2)
  575. trap(Q|I)
  576. window(10|16|8|60)
  577. pmsg("ABBREVIATION:";RPABBREVIATION|1|2|N|N|S|)
  578. pmsg("ENTER RPABBREV.NAME:"|1|4|N|N|S|RPABBREV.NAME)
  579. if RPABBREV.NAME = ("") goto NORPABV
  580. pmsg("ENTER WARNING:"|1|6|N|N|S|WARNING)
  581. pmsg("ENTER DRUGCODE:"|1|7|N|N|S|DRUGCODE)
  582. save(RPABBREV|N|N|GET.RPABBR)
  583. find(M|RPABBREV.NAME||)
  584. NORPABV:
  585. redsp(2)
  586. }
  587. PATMENRET:
  588. trap(Q|G|EXIT)
  589. gosub FIND_DRCD
  590. gosub FINDLINE
  591. clrlne(1|24)
  592. RETT:
  593. ret
  594. CLRABV:
  595. clr(ABBREV|B)
  596. clr(RPABBREV|B)
  597. ret
  598. LETTRAP:
  599. trap(D|I)
  600. trap(B|I)
  601. trap(G|I)
  602. trap(F|I)
  603. trap(R|I)
  604. trap(N|I)
  605. trap(M|I)
  606. trap(J|I)
  607. trap(U|I)
  608. trap(W|I)
  609. trap(C|I)
  610. trap(S|I)
  611. trap(I|D)
  612. ret
  613. FINDLINE:
  614. if PATCTR < (98) then gosub PAT.TRAP
  615. if PATCTR => (98) do
  616. {
  617. if PATCTR <= (202) then gosub RP.TRAP
  618. }
  619. else
  620. {
  621. if PATCTR > (202) then gosub TRAPS
  622. }
  623. ret
  624. MENU:
  625. TM[1] = (" 1 - AGE-SEX/REC      01011")
  626. TM[2] = (" 2 - MEMO ENTRY       01022")
  627. TM[3] = (" 3 - EXIT             01033")
  628. menu(30|20|4|23|0|TM|CHOICE|3|22|MENU||"-------GP MENU--------"|N)
  629. on(CHOICE|G|PAT_ENT;MEMO;EXIT3|MENU)
  630. PAT_ENT:
  631. run("PATREC")
  632. MEMO:
  633. find(B|MEM_NAME|MEM_EXIT|)
  634. MEM_NAME = (PATIENT.NAME)
  635. MEM_EXIT:
  636. save(MEMORY|N|Y)
  637. run("MEMO")
  638. TRACE:
  639. break
  640. ret
  641. EXIT:
  642. goto MENU
  643. EXIT2:
  644. pmsg("FILE LOCKED BY ANOTHER STATION"|10|24|Y|N|S|)
  645. clrlne(1|24)
  646. run("recmenu")
  647. RELATED:
  648. RP_POS =rcn(RP|G)
  649. RECORD.NUMBER = (RP.REF)
  650. find(M|RECORD.NUMBER|RELRET|N)
  651. RP_POS =rcn(RP|S)
  652. RELRET:
  653. ret
  654. FIND_DRCD:
  655. COD.REF = (RECORD.NUMBER)
  656. find(M|COD.REF|NEWCODG|)
  657. NEWCODG:
  658. COD.REF = (RECORD.NUMBER)
  659. COD.PAT.NAME = (PATIENT.NAME)
  660. if DRUGCODE = (0) do
  661. {
  662. COD.D[7] = (RP.FIRST+365)
  663. save(RECALLS|N|Y)
  664. ret
  665. }
  666. if DRUGCODE = (9) then COD.D[DRUGCODE] = (TD+182)
  667. if DRUGCODE = (5) then COD.D[DRUGCODE] = (TD+365)
  668. if DRUGCODE = (6) then COD.D[DRUGCODE] = (TD+365)
  669. if DRUGCODE = (7) then COD.D[DRUGCODE] = (TD+182)
  670. if DRUGCODE = (8) then COD.D[DRUGCODE] = (TD+365)
  671. if DRUGCODE = (9) then COD.D[DRUGCODE] = (TD+182)
  672. if DRUGCODE = (4) do
  673. {
  674. COD[DRUGCODE] = ("ORAL")
  675. COD.D[DRUGCODE] = (TD+182)
  676. }
  677. if DRUGCODE = (2) do
  678. {
  679. DRUGCODE = (DRUGCODE+2)
  680. COD[DRUGCODE] = ("INS")
  681. COD.D[DRUGCODE] = (TD+182)
  682. }
  683. save(RECALLS|N|Y)
  684. ret
  685. PAT.LOCK:
  686. pmsg("RECORD IN USE - PRESS RETURN AND TRY AGAIN LATER"|10|24|Y|N|S|)
  687. clr(PATIENT|B)
  688. clrlne(1|24)
  689. goto PAT.NAME
  690. PAT.LOCKRP:
  691. pmsg("RECORD IN USE - PRESS RETURN AND TRY AGAIN LATER"|10|24|Y|N|S|)
  692. clr(RP|B)
  693. clr(PATIENT|B)
  694. clrlne(1|24)
  695. goto RP.NAME
  696. RP.LOCK:
  697. pmsg("RECORD IN USE - PRESS RETURN AND TRY AGAIN LATER"|10|24|Y|N|S|)
  698. clr(PATIENT|B)
  699. clr(RP|B)
  700. clrlne(1|24)
  701. goto RP.NAME
  702. PAT.LOCKCO:
  703. pmsg("RECORD.IN USE - PRESS RETURN AND TRY AGAIN LATER"|10|24|Y|N|S|)
  704. clr(RECALLS|B)
  705. clr(PATIENT|B)
  706. clrlne(1|24)
  707. goto COD.NAME
  708. COD.LOCK:
  709. pmsg("RECORD IN USE - PRESS RETURN AND TRY AGAIN LATER"|10|24|Y|N|S|)
  710. clr(PATIENT|B)
  711. clr(RECALLS|B)
  712. clrlne(1|24)
  713. goto CCDA
  714. DEL.LOCK:
  715. pmsg("A RECORD IS IN USE FOR THIS PATIENT - TRY AGAIN LATER"|10|24|Y|N|S|)
  716. clr(PATIENT|B)
  717. clr(RP|B)
  718. clr(RECALLS|B)
  719. clrlne(1|24)
  720. goto DELETE
  721. EXIT3:
  722. run("recmenu")
  723. FILE_ERROR:
  724. lferrn(LAST_ERROR)
  725. if LAST_ERROR = (61) do
  726. {
  727. REC.NUM = (REC.NUM+1)
  728. RECORD.NUMBER = (REC.NUM)
  729. save(PATIENT|N|Y)
  730. goto SAVE.QQQX
  731. }
  732. else
  733. {
  734. if LAST_ERROR = (5) do
  735. {
  736. pmsg("DUPLICATE PATIENT NAME - START AGAIN"|20|24|Y|N|S|)
  737. run("PATIENT")
  738. }
  739. else
  740. {
  741. pmsg("last error";LAST_ERROR|40|24|N|N|S|)
  742. goto PAT.NAME
  743. }
  744. }
  745. ;|
  746. ;|
  747. PATMENU:
  748. trap(%|G|RETNOAB)
  749. MENU.HLDR[1] = (" A - xxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 0101A")
  750. MENU.HLDR[2] = (" B - xxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 0102B")
  751. MENU.HLDR[3] = (" C - xxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 0103C")
  752. MENU.HLDR[4] = (" D - xxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 0104D")
  753. MENU.HLDR[5] = (" E - xxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 0105E")
  754. MENU.HLDR[6] = (" F - xxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 0106F")
  755. MENU.HLDR[7] = (" G - xxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 0107G")
  756. MENU.HLDR[8] = (" H - xxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 0108H")
  757. MENU.HLDR[9] = (" I - xxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 0109I")
  758. MENU.HLDR[10] = (" J - xxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 0110J")
  759. MENU.HLDR[11] = (" K - xxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 0111K")
  760. MENU.HLDR[12] = (" L - xxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 0112L")
  761. MENU.HLDR[13] = (" M - more                                 0113M")
  762. RPABBREV.NAME = (AB)
  763. find(G|RPABBREV.NAME|RETRETRET|)
  764. XCNTR6 = (1)
  765. XCNTR = (1)
  766. YCNTR = (1)
  767. XCNTR2 = (0)
  768. FILES.1:
  769. mid(DUMMY|XCNTR|5|RPABBREVIATION|1)
  770. mid(DUMMY2|YCNTR|30|RPABBREV.NAME|2)
  771. XCNTR = (XCNTR + 5)
  772. YCNTR = (YCNTR+30)
  773. XCNTR2 = (XCNTR2 + 1)
  774. FILES.1X:
  775. find(N|RPABBREV|FILES.2|)
  776. XCNTR6 = (1+XCNTR6)
  777. if XCNTR6 > (39) then goto FILES.2
  778. goto FILES.1
  779. FILES.2:
  780. XCNTR = (1)
  781. YCNTR = (1)
  782. FILES.3:
  783. XCNTR1 = (1)
  784. FILES.4:
  785. RPABBREVIATION =mid(DUMMY|XCNTR|5|1)
  786. RPABBREV.NAME =mid(DUMMY2|YCNTR|30|2)
  787. mid(MENU.HLDR[XCNTR1]|6|5|RPABBREVIATION|)
  788. mid(MENU.HLDR[XCNTR1]|12|30|RPABBREV.NAME|)
  789. XCNTR2 = (XCNTR2 - 1)
  790. XCNTR = (XCNTR + 5)
  791. YCNTR = (YCNTR+30)
  792. if XCNTR2 > (0) do
  793. {
  794. if XCNTR1 < (12) do
  795. {
  796. XCNTR1 = (XCNTR1 + 1)
  797. goto FILES.4
  798. }
  799. else
  800. {
  801. XCNTR1 = (XCNTR1 + 1)
  802. goto FILES.5
  803. }
  804. }
  805. FILES.5:
  806. RPABBREVIATION = ("")
  807. RPABBREV.NAME = ("")
  808. XCNTR3 = (XCNTR1 + 1)
  809. XCNTR5 = (1)
  810. menu(12|19|XCNTR3|43|0|MENU.HLDR|XCNTR5|XCNTR1|42|RETNOAB||"RP ABBREVIATIONS"|N)
  811. if XCNTR5 < (13) do
  812. {
  813. if FLAG = ("A") do
  814. {
  815. MEDICATION =mid(MENU.HLDR[XCNTR5]|12|30|)
  816. RPABBREV.NAME = (MEDICATION)
  817. find(M|RPABBREV.NAME|RETNOAB|N)
  818. RPWARNING = (WARNING)
  819. FLAG = ("X")
  820. gosub FIND_DRCD
  821. trap(%|I)
  822. clr(RPABBREV|B)
  823. goto LIST_DRUG
  824. }
  825. else
  826. {
  827. DIRECTIONS =mid(MENU.HLDR[XCNTR5]|12|30|)
  828. FLAG = ("X")
  829. trap(%|I)
  830. clr(RPABBREV|B)
  831. goto DIR_FIND
  832. }
  833. }
  834. goto FILES.3
  835. RETRETRET:
  836. trap(%|I)
  837. clr(RPABBREV|B)
  838. goto LIST_DRUG
  839. RETNOAB:
  840. trap(%|I)
  841. clr(RPABBREV|B)
  842. if FLAG = ("A") then MEDICATION = (AB)
  843. if FLAG = ("B") then DIRECTIONS = (AB)
  844. goto RESTRICT
  845. SIX:
  846. dos("SI")
  847. ret
  848. CHECK:
  849. if PRINTP = ("") ret
  850. if PRINTP => ("1") do
  851. {
  852. saves(1)
  853. window(2|12|2|76)
  854. pmsg("THERE IS A REGISTRATION PROBLEM WITH THIS PATIENT - CHECK CODE ";PRINTP|1|1|Y|N|S|)
  855. redsp(1)
  856. }
  857. ret
  858. REL_RP:
  859. trap(R|D)
  860. if RP.REF = (0) ret
  861. RECORD.NUMBER = (RP.REF)
  862. find(M|RECORD.NUMBER||)
  863. ret
  864. SEEALL:
  865. STARTALL1:
  866. mount(NEW|S)
  867. STARTALL:
  868. if RECORD.NUMBER = (0) goto ENDIT
  869. COD.REF = (RECORD.NUMBER)
  870. find(M|COD.REF|NEXTALL|)
  871. NEXTALL:
  872. IMDATE.COD = (RECORD.NUMBER)
  873. find(M|IMDATE.COD|NEXTALL1|)
  874. NEXTALL1:
  875. P_COD = (RECORD.NUMBER)
  876. find(M|P_COD|NEXTALL2|)
  877. NEXTALL2:
  878. RP.REF = (RECORD.NUMBER)
  879. find(M|RP.REF|ENDIT|)
  880. CTR = (1)
  881. TESTALL:
  882. AOD[CTR] = (AUTO.ON.DEMAND)
  883. MN[CTR] = (MEDICATION)
  884. DO[CTR] = (DOSE)
  885. QU[CTR] = (QUANTITY)
  886. DS[CTR] = (DIRECTIONS)
  887. QTY[CTR] = (RP.DISP.QTY)
  888. ISN[CTR] = (ISSUE.NO)
  889. MEM_RPD[CTR] = (RP.NEXT.DUE)
  890. trim(MN[CTR]|T)
  891. trim(QU[CTR]|T)
  892. just(QU[CTR]|L)
  893. trim(DO[CTR]|T)
  894. just(DO[CTR]|L)
  895. trim(DS[CTR]|T)
  896. just(DS[CTR]|L)
  897. CTR2 = (CTR+9)
  898. pmsg(AOD[CTR];" ";MN[CTR];" ";DO[CTR];" ";QU[CTR];" ";DS[CTR];" ";QTY[CTR];" ";ISN[CTR]|1|CTR2|N|N|S|)
  899. ctr2 = (ctr2)
  900. find(N|RP|ENDIT|)
  901. if RP.REF <> (RECORD.NUMBER) goto ENDIT
  902. CTR = (CTR+1)
  903. goto TESTALL
  904. CLEARXALL:
  905. clr(RP|B)
  906. clr(RECALLS|B)
  907. clr(IMDATE|B)
  908. clr(PAEDS|B)
  909. clrmem(AOD|10)
  910. clrmem(MN|10)
  911. clrmem(MEM_RPD|10)
  912. clrmem(DO|10)
  913. clrmem(QU|10)
  914. clrmem(DS|10)
  915. clrmem(QTY|10)
  916. clrmem(ISN|10)
  917. ret
  918. ENDIT:
  919. enter(PATIENT.NAME||||N|N|N|||N)
  920. gosub CLEARXALL
  921. mount(PATIENT|S)
  922. find(M|RECORD.NUMBER|PAT.NAME|)
  923. goto PAT.NAME
  924. VIS_HELP:
  925. saves(1)
  926. window(1|12|2|78)
  927. pmsg("Enter a Y if there was a NEW patient consultation - blank otherwise"|1|1|Y|N|S|)
  928. redsp(1)
  929. ret
  930. 75_HELP:
  931. saves(1)
  932. window(1|12|3|78)
  933. pmsg("Enter a Y if the patient responds to invitation positively ie yes please"|1|1|N|N|S|)
  934. pmsg(" Y,S,V are valid but only use blank or Y - Leave S,V, well alone"|1|2|Y|N||)
  935. redsp(1)
  936. ret
  937. \STPATIENT 
  938.  
  939.                           AGE-SEX REGISTER AND RP ENTRY
  940.            ┌───────────────────────────────────────────────────────┐
  941.            │ Pat.Name :&                          <                │
  942.            │ Address @:&                     <                     │
  943.            │ Area    @:&                                           │
  944.            │ Postcode :&                                           │
  945.            │ Date.o.b.:&         <                                 │
  946.            │ Mar/Sing.:&                                           │
  947.            │ Sex      :&                                           │
  948.            │ Disp.?   :&<(YNX)                                     │
  949.            │ Doctor   :&               Age              :&         │
  950.            │ NHS No.  :&         <     Sent for 3yr/75+ :&         │
  951.            │ Pat.reg  :&        &      Replied/Visited  :&         │
  952.            │ Notes.Rec:&               Last update      :&         │
  953.            │ Tel      :&               List Size        :&         │
  954.            │ Seen     :&       <                                   │
  955.            │ New P Exm:& Attended?                                 │
  956.            └───────────────────────────────────────────────────────┘
  957.              F1 - Help     F2 -Rp      Tab - Info      Esc - menu
  958.  
  959.  
  960.  
  961.  
  962. \
  963. PATIENT.NAME
  964. ADDRESS1
  965. AREA
  966. POSTCODE
  967. DATE.OF.BIRTH
  968. MARITAL.STATUS
  969. SEX
  970. DISPENSING
  971. DOCTOR
  972. AGE
  973. NHS.NUM
  974. SENT_FOR
  975. PAT.REG
  976. PAT_FLAG
  977. VISIT
  978. NOTES.REC
  979. LAST.UPDATE
  980. TELEPHONE
  981. LIST_SIZE
  982. SEEN
  983. SMOKER
  984. \
  985. \STRP      
  986.  
  987.  
  988.                                REPEAT PRESCRIBING
  989.  ┌─────────────────────────────────────────────────────────────────────────────┐
  990.  │             Patient Name:&                          <      Tel :&           │
  991.  │ Address:&                         &                      D.O.B.:&         < │
  992.  └─────────┬───────────────────────────────────────┬─────────────────┬─────────┘
  993.            │  Auto/on demand? A/D :&               │Numb.Issued:&    │
  994.            │     Restrictions? Y/N:&for:&   issues.│Numb.to go :&  < │
  995.            │         Starting.date:&               └─────────────────┤
  996.            │    Days between issue:&                                 │
  997.            │            Last.issue:&                                 │
  998.            │           RP.Next.Due:&                                 │
  999.            │          Medication @:&                             <   │
  1000.            │               Warning:&                                 │
  1001.            │              Strength:&                                 │
  1002.            │                  Dose:&                                 │
  1003.            │          Directions @:&                                 │
  1004.            │          Qtity / Type &  /&                             │
  1005.            └─────────────────────────────────────────────────────────┘
  1006.               F1 - help       @ - use abbreviation      Esc - menu
  1007.  
  1008.  
  1009.  
  1010. \
  1011. PATIENT.NAME
  1012. TELEPHONE
  1013. ADDRESS1
  1014. AREA
  1015. DATE.OF.BIRTH
  1016. AUTO.ON.DEMAND
  1017. ISSUE.NO
  1018. ISS.RESTRICT
  1019. HOW.MANY.ISSUES
  1020. RESTRICT.NO
  1021. RP.FIRST
  1022. RP.DAYS.SUPPLY
  1023. ISSUE.1
  1024. RP.NEXT.DUE
  1025. MEDICATION
  1026. RPWARNING
  1027. DOSE
  1028. QUANTITY
  1029. DIRECTIONS
  1030. RP.DISP.QTY
  1031. RP.WHAT.DISP
  1032. \
  1033. \STNEW     
  1034. &                           &                      &
  1035. DOB:&          M/S:& SEX:& DISP:& DR:& REG:&        NOTS:&        TEL:&
  1036. SEEN:&        SENT:&        NHS:&          LASTUP:&
  1037.  
  1038. SMEAR:&   :&        LAST:&        & CONTRA:&   :&        IMMUN:&   :&
  1039. DIAB: &   :&        PAED:&   :&        THY:&   :&          RP: &   :&
  1040. ASTH: &   :&          BP:&   :&        PAEDS:&       :&       :&       :&
  1041. IMMNS:&       :&       :&       :&       :&
  1042.  
  1043.  
  1044.  
  1045.  
  1046.  
  1047.  
  1048.  
  1049.  
  1050.  
  1051.  
  1052.  
  1053.  
  1054.  
  1055.  
  1056.  
  1057. ESC - EXIT  F3 - CLEAR
  1058. \
  1059. PATIENT.NAME
  1060. ADDRESS1
  1061. AREA
  1062. DATE.OF.BIRTH
  1063. MARITAL.STATUS
  1064. SEX
  1065. DISPENSING
  1066. DOCTOR
  1067. PAT.REG
  1068. NOTES.REC
  1069. TELEPHONE
  1070. SEEN
  1071. SENT_FOR
  1072. NHS.NUM
  1073. LAST.UPDATE
  1074. COD[1]
  1075. COD.D[1]
  1076. SM_DATE
  1077. WHERE
  1078. COD[2]
  1079. COD.D[2]
  1080. COD[3]
  1081. COD.D[3]
  1082. COD[4]
  1083. COD.D[4]
  1084. COD[5]
  1085. COD.D[5]
  1086. COD[6]
  1087. COD.D[6]
  1088. COD[7]
  1089. COD.D[7]
  1090. COD[8]
  1091. COD.D[8]
  1092. COD[9]
  1093. COD.D[9]
  1094. PDATE1
  1095. PDATE2
  1096. PDATE3
  1097. PDATE4
  1098. IMDATE1
  1099. IMDATE2
  1100. IMDATE3
  1101. IMDATE4
  1102. IMDATE5
  1103. \
  1104.